home *** CD-ROM | disk | FTP | other *** search
/ Info-Mac 4 / Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso / Development / General / ViewIt™ 2.24 Shareware / Pascal Demo Projects / THINK Pascal 4.0 Demos / FaceProcLP.pas next >
Pascal/Delphi Source File  |  1993-08-28  |  3KB  |  122 lines
  1. {FaceWare 2.2 Initialization & Dispatching Procedures}
  2. {©FaceWare 1989-93.  All Rights Reserved.}
  3.  
  4. unit FaceProcLP;
  5.  
  6. interface
  7.  
  8.     uses
  9.         FaceStorLP;
  10.     type
  11.         HeadRec = record
  12.                 addr: ProcPtr;
  13.                 baseID: integer;
  14.                 versID: integer;
  15.                 message: integer;
  16.                 resID: integer;
  17.                 fPtr: Ptr;
  18.             end;
  19.         HeadPtr = ^HeadRec;
  20.     var
  21.         fRec: FaceRec;
  22.  
  23.     procedure FaceIt (thePtr: univ Ptr;
  24.                                     m1, m2, m3, m4, m5: longint);
  25.  
  26. implementation
  27.  
  28.     procedure PrepIt (x, b, v, r, f: longint);
  29.         var
  30.             i: integer;
  31.     begin
  32.         with HeadPtr(x)^ do
  33.             begin
  34.                 addr := GetResource('FCMD', 1000)^;
  35.                 baseID := b;
  36.                 versID := v;
  37.                 message := 0;
  38.                 resID := r;
  39.                 fPtr := pointer(f);
  40.                 with fRec do
  41.                     if (xEntries > 0) then
  42.                         for i := 0 to xEntries - 1 do
  43.                             if (baseID = xTable[1 + i * 4]) then
  44.                                 if (versID = xTable[2 + i * 4]) then
  45.                                     if (xTable[4 + i * 4] <> 0) then
  46.                                         addr := ProcPtr(xTable[4 + i * 4]);
  47.             end;
  48.     end;
  49.  
  50.     procedure JumpIt (thePtr: Ptr);
  51.     inline
  52.         $2257, $2051, $4E90;
  53.  
  54.     procedure FaceIt;
  55.         var
  56.             i: integer;
  57.     begin
  58.         with fRec do
  59.             begin
  60.                 if (m1 = DoInit) then
  61.                     begin
  62.                         if (m4 > -1) and not BitTst(@m4, 31) then
  63.                             begin
  64.                                 FlushEvents(62, 0);        {ignore spurious mouse and key events}
  65.                                 InitGraf(@thePort);        {perform appropriate Mac initializations}
  66.                                 InitFonts;
  67.                                 InitWindows;
  68.                                 InitMenus;
  69.                                 TEInit;
  70.                                 InitDialogs(nil);
  71.                             end;
  72.                         if (GetResource('FCMD', 1000) = nil) then    {LoadIt available?}
  73.                             if (OpenResFile(StringPtr(StripAddress(@uName))^) < 0) then
  74.                                 ExitToShell;                                        {quit if not found}
  75.                         fFlags := m2;                                        {store FaceIt bit flags}
  76.                         xEntries := m5;                                    {store # of table entries}
  77.                         thePtr := @fRec;
  78.                         if (m3 > -1) then                                    {call LoadIt to expand heap?}
  79.                             begin
  80.                                 PrepIt(ord(thePtr), m3, 0, 0, ord(thePtr));
  81.                                 JumpIt(thePtr);
  82.                             end;
  83.                         PrepIt(ord(thePtr), 1100, 22, 0, ord(thePtr));        {setup fRec header}
  84.                         PrepIt(ord(@uHead), 1210, 22, 0, ord(thePtr));    {setup uRec header}
  85.                         PrepIt(ord(@vHead), 1200, 22, 0, ord(thePtr));    {setup vRec header}
  86.                         fHead[6] := m4;                                    {store environment type}
  87.                         uHead[6] := 0;                                        {store string type}
  88.                         thePtr := nil;
  89.                         if (m4 < -3) then
  90.                             exit(FaceIt);
  91.                     end;
  92.                 if (m1 = DoPrep) then
  93.                     PrepIt(m2, m3, m4, m5, ord(@fRec))
  94.                 else if (m1 < 0) and (m1 > -11) then
  95.                     begin
  96.                         i := (4 * (-1 - m1));
  97.                         xTable[1 + i] := m2;
  98.                         xTable[2 + i] := m3;
  99.                         xTable[3 + i] := m4;
  100.                         xTable[4 + i] := m5;
  101.                     end
  102.                 else
  103.                     begin
  104.                         if (thePtr = nil) then        {call to the default module?}
  105.                             thePtr := @uHead
  106.                         else if (HeadPtr(thePtr)^.fPtr <> @fRec) then
  107.                             begin                            {call to a control driver?}
  108.                                 cControl := pointer(thePtr);
  109.                                 thePtr := @vHead;
  110.                             end;
  111.                         HeadPtr(thePtr)^.message := 0;
  112.                         uCommand := m1;                {pass Command & Params}
  113.                         uParam[1] := m2;
  114.                         uParam[2] := m3;
  115.                         uParam[3] := m4;
  116.                         uParam[4] := m5;
  117.                         JumpIt(thePtr);                {jump to FCMD module}
  118.                     end;
  119.             end;
  120.     end;
  121.  
  122. end.